Rsetwd("~/GitHub/UNIGE/32M7129/Cours_08")
#je charge les données que l'enseignant a préparé pour éviter les problèmes
#load("Cours_Geneve_8.RData")if(!require("devtools")){
install.packages("devtools")
library(devtools)
}
if(!require("igraph")){
install.packages("igraph")
library(igraph)
}
if(!require("tidyverse")){
install.packages("tidyverse")
library(tidyverse)
}
if(!require("tidygraph")){
install.packages("tidygraph")
library(tidygraph)
}
if(!require("ggraph")){
install.packages("ggraph")
library(ggraph)
}
if(!require("qgraph")){
install.packages("qgraph")
library(qgraph)
}
if(!require("corrr")){
install.packages("corrr")
library(corrr)
}
if(!require("visNetwork")){
install.packages("visNetwork")
library(visNetwork)
}
if(!require("networkD3")){
install.packages("networkD3")
library(networkD3)
}
if(!require("ForceAtlas2")){
devtools::install_github("analyxcompany/ForceAtlas2")
library(ForceAtlas2)
}
if(!require("rgl")){
install.packages("rgl")
library(rgl)
}
if(!require("igraphdata")){
install.packages("igraphdata")
library(igraphdata)
}
if(!require("netrankr")){
install.packages("netrankr")
library(netrankr)
}
if(!require("popgraph")){
devtools::install_github("dyerlab/popgraph")
library(popgraph)
}
if(!require("ggmap")){
install.packages("ggmap")
library(ggmap)
}Je charge mes deux fichiers: celui avec les nœuds (nodes.csv) et celui avec les arêtes (edges.csv).
nodes <- as.data.frame(read.csv(file="data/basic/nodes.csv", sep = "\t", header = FALSE))
edges <- as.data.frame(read.csv(file="data/basic/edges.csv", sep = "\t", header = FALSE))
#Je donne un nom aux colonnes de chaque data.frame
colnames(nodes) <- c("id", "label","type")
colnames(edges) <- c("from", "to")
#Je contrôle que tout est en ordreJ’affiche les premiers éléments de chaque fichier, et je compte les rangs pour me faire une idée de ce qui se trouve dans mes données
head(nodes)
head(edges)
nrow(nodes); length(unique(nodes$id))
nrow(edges); nrow(unique(edges[,c("from", "to")]))## id label type
## 1 1 Molière Auteur
## 2 2 Guillaume de Luyne Libraire
## 3 3 Claude Barbin Libraire
## 4 4 Charles de Sercy Libraire
## 5 5 Jean Hénault Imprimeur
## 6 6 François Noël Imprimeur
## from to
## 1 1 2
## 2 1 3
## 3 1 4
## 4 1 5
## 5 1 6
## 6 1 7
## [1] 27
## [1] 27
## [1] 242
## [1] 106
Je transforme ces deux objets en données igraph, qui vont me permettre de faire mes analyses de réseau par la suite.
## [1] "igraph"
Mes données se présentent sous cette forme:
## IGRAPH 8c8a8f7 UN-B 27 242 --
## + attr: name (v/c), label (v/c), type (v/c)
## + edges from 8c8a8f7 (vertex names):
## [1] 1 --2 1 --3 1 --4 1 --5 1 --6 1 --7 2 --3 2 --4 2 --5 2 --6
## [11] 2 --7 3 --4 3 --5 3 --6 3 --7 4 --5 4 --6 4 --7 5 --6 5 --7
## [21] 6 --7 1 --8 1 --9 1 --7 8 --9 7 --8 7 --9 1 --4 1 --2 1 --10
## [31] 1 --3 1 --12 1 --7 2 --4 4 --10 3 --4 4 --12 4 --7 2 --10 2 --3
## [41] 2 --12 2 --7 3 --10 10--12 7 --10 3 --12 3 --7 7 --12 1 --2 1 --4
## [51] 1 --10 1 --3 1 --12 1 --7 2 --4 2 --10 2 --3 2 --12 2 --7 4 --10
## [61] 3 --4 4 --12 4 --7 3 --10 10--12 7 --10 3 --12 3 --7 7 --12 1 --3
## [71] 1 --12 1 --7 3 --12 3 --7 7 --12 1 --3 1 --12 1 --13 3 --12 3 --13
## + ... omitted several edges
Je peux désormais afficher les nœuds, les arêtes de cette manière. Je peux aussi sélectionner certaines colonnes pour chaque fichier d’une manière particulière aux objets igraph
## + 242/242 edges from 8c8a8f7 (vertex names):
## [1] 1 --2 1 --3 1 --4 1 --5 1 --6 1 --7 2 --3 2 --4 2 --5 2 --6
## [11] 2 --7 3 --4 3 --5 3 --6 3 --7 4 --5 4 --6 4 --7 5 --6 5 --7
## [21] 6 --7 1 --8 1 --9 1 --7 8 --9 7 --8 7 --9 1 --4 1 --2 1 --10
## [31] 1 --3 1 --12 1 --7 2 --4 4 --10 3 --4 4 --12 4 --7 2 --10 2 --3
## [41] 2 --12 2 --7 3 --10 10--12 7 --10 3 --12 3 --7 7 --12 1 --2 1 --4
## [51] 1 --10 1 --3 1 --12 1 --7 2 --4 2 --10 2 --3 2 --12 2 --7 4 --10
## [61] 3 --4 4 --12 4 --7 3 --10 10--12 7 --10 3 --12 3 --7 7 --12 1 --3
## [71] 1 --12 1 --7 3 --12 3 --7 7 --12 1 --3 1 --12 1 --13 3 --12 3 --13
## [81] 12--13 1 --2 1 --4 1 --14 1 --15 1 --16 1 --10 1 --3 1 --12 1 --5
## [91] 2 --4 2 --14 2 --15 2 --16 2 --10 2 --3 2 --12 2 --5 4 --14 4 --15
## + ... omitted several edges
## + 27/27 vertices, named, from 8c8a8f7:
## [1] 1 2 3 4 5 6 7 8 9 10 12 13 14 15 16 17 18 19 20 21 22 23 24
## [24] 25 26 27 28
## [1] "Molière" "Guillaume de Luyne"
## [3] "Claude Barbin" "Charles de Sercy"
## [5] "Jean Hénault" "François Noël"
## [7] "Christophe Journel" "Sieur de Neuf-Villenaine"
## [9] "Jean Ribou" "Jean Guignard"
## [11] "Gabriel Quinet" "François II Noël"
## [13] "Thomas Jolly" "Louis Billaine"
## [15] "Estienne Loyson" "Claude Blageart"
## [17] "Pierre Trabouillet" "Nicolas Le Gras"
## [19] "Théodore Girard" "Etienne Maucroy"
## [21] "Claude II Calleville" "Claude Audinet"
## [23] "Pierre Le Monnier" "Pierre Corneille"
## [25] "Philippe Quinault" "Pierre Promé"
## [27] "François Muguet"
## [1] "Auteur" "Libraire" "Libraire" "Libraire" "Imprimeur"
## [6] "Imprimeur" "Imprimeur" "Libraire" "Libraire" "Libraire"
## [11] "Libraire" "Imprimeur" "Libraire" "Libraire" "Libraire"
## [16] "Imprimeur" "Libraire" "Libraire" "Libraire" "Imprimeur"
## [21] "Imprimeur" "Imprimeur" "Libraire" "Auteur" "Auteur"
## [26] "Libraire" "Imprimeur"
Je peux désormais fabriquer mon réseau avec la fonction plot:
Il existe une fonction alternative plot.igraph, qui fait la même chose
Il existe enfin une fonction tkplot qui est un prototype d’interface utilisateur:
Je dispose d’un grand nombre de paramètres pour modifier l’apparence de mon graph et le rendre (si on en a le talent) esthétique:
plot(data,
#courbure de l'arête
edge.curved=0.1,
#couleur de l'arête
edge.color="orange",
#couleur du nœud
vertex.color="green",
#couleur du contour du nœud
vertex.frame.color="#555555",
#couleur de l'étiquette du nœud
vertex.label.color="darkred",
#contenu de l'étiquette du nœud
vertex.label=V(data)$type,
#taille de la police
vertex.label.cex=1) On peut customiser encore plus la décoration en intervenant plus lourdement sur la mise en page. Une manière de faire va être de créer des vecteurs à partir des données, en substituant la valeur qui nous intéresse par la forme que l’on souhaite lui donner. Par exemple, si je veux changer la couleur du nœud en fonction du label
#J'ai une colonne de mon objet igraph avec les labels
V(data)$type
#je copie le contenu de cette colonne dans un nouvel objet
to_colors<-V(data)$type
#Je substitue toute les cellules avec l'information `libraire` par la couleur souhaitée
to_colors<-replace(to_colors,to_colors=="Libraire","orange")
to_colors
#Je continue avec les autres valeurs
to_colors<-replace(to_colors,to_colors=="Auteur","green")
to_colors<-replace(to_colors,to_colors=="Imprimeur","red")
#J'obtiens un nouvel objet avec des couleurs à la place des labels
to_colors## [1] "Auteur" "Libraire" "Libraire" "Libraire" "Imprimeur"
## [6] "Imprimeur" "Imprimeur" "Libraire" "Libraire" "Libraire"
## [11] "Libraire" "Imprimeur" "Libraire" "Libraire" "Libraire"
## [16] "Imprimeur" "Libraire" "Libraire" "Libraire" "Imprimeur"
## [21] "Imprimeur" "Imprimeur" "Libraire" "Auteur" "Auteur"
## [26] "Libraire" "Imprimeur"
## [1] "Auteur" "orange" "orange" "orange" "Imprimeur"
## [6] "Imprimeur" "Imprimeur" "orange" "orange" "orange"
## [11] "orange" "Imprimeur" "orange" "orange" "orange"
## [16] "Imprimeur" "orange" "orange" "orange" "Imprimeur"
## [21] "Imprimeur" "Imprimeur" "orange" "Auteur" "Auteur"
## [26] "orange" "Imprimeur"
## [1] "green" "orange" "orange" "orange" "red" "red" "red"
## [8] "orange" "orange" "orange" "orange" "red" "orange" "orange"
## [15] "orange" "red" "orange" "orange" "orange" "red" "red"
## [22] "red" "orange" "green" "green" "orange" "red"
Je peux désormais appliquer cette couleur à chaque nœud
#J'ai une colonne couleur qui est vide, que je vais remplir avec l'objet `to_colors` que je viens de créer
V(data)$color
#Je remplace la couleur du graphe avec celle que je viens de définir
V(data)$color <- to_colors
#Le graphe change de couleur
plot(data)Je peux faire la même opération avec la forme des nœuds, et améliorer encore le rendu.
ATTENTION: le rendu dans RStudio n’est pas forcément optimum: pensez l’ouvrir dans une nouvelle fenêtre pour voir le résultat.
#On change la forme du nœud en fonction du label
to_shape<-V(data)$type
to_shape<-replace(to_shape,to_shape=="Auteur","square")
to_shape<-replace(to_shape,to_shape=="Imprimeur","circle")
to_shape<-replace(to_shape,to_shape=="Libraire","sphere")
#Je peux à nouveau changer l'objet igraph
V(data)$color <- to_colors
V(data)$label.color <- "black"
#E(data)$edge.color <- "gray80"
#ou bien intervenir directement dans les paramètres du graphe
plot(data,
vertex.label.degree=2,
#on injecte le vecteur avec les formes que nous venons de créer
vertex.shape=to_shape,
#taille des nœuds
vertex.size = 10,
#taille de la police
vertex.label.cex=0.7
)
title("mon graphe", sub="premier test")
#J'ajoute une petite légende
legend(x=-1.5, y=-1.1, c("Auteur","Libraire", "Imprimeur"), pch=21,
col="#777777", pt.bg=c("green", "orange", "red"), pt.cex=2, cex=.8, bty="n", ncol=1)Nous avons encore un problème: les relations multiples sont toutes dessinées, car elles sont restées dans le tableau. Quelles sont-elles?
Deux problèmes sont possibles: * Une boucle (loop) est un nœud relié par une arête à lui-même * Un multiple (multiple) sont deux nœuds reliés plusieurs fois ensemble. N.B. si le graph est dirigé 2->1 n’est pas un multiple de 1->2, mais s’il est dirigé oui.
## [1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [12] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [23] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [34] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [45] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [56] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [67] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [78] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [89] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [100] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [111] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [122] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [133] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [144] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [155] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [166] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [177] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [188] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [199] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [210] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [221] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [232] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [12] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [23] FALSE TRUE FALSE FALSE FALSE TRUE TRUE FALSE TRUE FALSE TRUE
## [34] TRUE FALSE TRUE FALSE TRUE FALSE TRUE FALSE TRUE FALSE FALSE
## [45] FALSE FALSE TRUE FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [56] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [67] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [78] FALSE TRUE FALSE FALSE TRUE TRUE FALSE FALSE FALSE TRUE TRUE
## [89] TRUE TRUE TRUE FALSE FALSE FALSE TRUE TRUE TRUE TRUE FALSE
## [100] FALSE FALSE TRUE TRUE TRUE TRUE FALSE FALSE FALSE FALSE FALSE
## [111] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE
## [122] TRUE FALSE TRUE TRUE FALSE TRUE TRUE TRUE TRUE TRUE TRUE
## [133] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [144] TRUE TRUE TRUE TRUE TRUE TRUE FALSE TRUE TRUE TRUE TRUE
## [155] TRUE TRUE TRUE TRUE TRUE TRUE FALSE TRUE TRUE TRUE FALSE
## [166] TRUE TRUE TRUE TRUE TRUE TRUE FALSE FALSE FALSE FALSE FALSE
## [177] FALSE FALSE FALSE FALSE FALSE TRUE FALSE FALSE TRUE FALSE FALSE
## [188] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [199] TRUE TRUE FALSE FALSE TRUE TRUE TRUE TRUE FALSE TRUE TRUE
## [210] FALSE FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE FALSE FALSE
## [221] TRUE TRUE TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE
## [232] TRUE TRUE FALSE TRUE TRUE FALSE FALSE TRUE TRUE FALSE FALSE
Comme j’ai de nombreux multiples, je vais les transformer en poids pour chaque arête
#Je compte les multiples pour chaque arête
count_multiple(data)
#Je fais une copie pour travailler dessus (si j'ai besoin des données originales plus tard)
data_simplified <- data
#Je copie-colle le nombre de multiple par arête dans la colonne des poids
E(data_simplified)$weight <- count_multiple(data_simplified)
#je retire les doublons (les multiples) avec la fonction simplify()
data_simplified <- simplify(data_simplified)## [1] 5 7 5 2 1 6 5 5 2 1 4 5 2 1 5 2 1 4 1 1 1 1 13
## [24] 6 1 1 1 5 5 4 7 6 6 5 4 5 4 4 4 5 4 4 4 4 3 6
## [47] 5 4 5 5 4 7 6 6 5 4 5 4 4 4 5 4 4 4 4 3 6 5 4
## [70] 7 6 6 6 5 4 7 6 1 6 1 1 5 5 2 2 2 4 7 6 2 5 2
## [93] 2 2 4 5 4 2 2 2 2 4 5 4 2 2 2 2 2 2 1 2 2 2 2
## [116] 1 2 2 2 1 4 4 1 6 2 1 5 2 5 2 2 4 7 6 6 2 5 2
## [139] 2 4 5 4 4 2 2 2 2 2 2 1 2 2 4 5 4 4 2 2 2 2 1
## [162] 2 2 2 1 4 4 3 6 5 4 1 1 1 1 1 1 1 1 1 1 13 11 10
## [185] 13 1 1 13 11 10 13 11 10 13 11 10 13 11 10 13 1 1 11 13 11 10 3
## [208] 11 13 3 3 10 3 11 13 3 3 10 1 2 3 13 11 1 1 1 1 1 1 1
## [231] 3 3 10 1 13 11 1 1 10 2 1 1
J’affiche mon nouveau graph: la largeur de l’arête dépend désormais du poids
E(data_simplified)$width <-E(data_simplified)$weight/2
plot(data_simplified,
#pas de courbure de l'arête
edge.curved=0,
#distance entre le label et le nœud
vertex.label.dist=1,
#Choix de la police
vertex.label.family="Times",
#Choix de la forme
vertex.shape=to_shape,
# Taile du nœud
vertex.size = 6,
#taille de la police
vertex.label.cex=0.6
)
title("Et voilà!")
#J'ajoute une petite légende
legend(x=-2, y=-0.5, c("Auteur","Libraire", "Imprimeur"), pch=21,
col="#777777", pt.bg=c("green", "orange", "red"), pt.cex=1, cex=.8, bty="n", ncol=1)Il existe différentes visualisation, algorithmes, etc. La logique est toujours la même: je pré-traite mon objet igraph avec une fonction spécifique au tracé choisi, et j’utilise le résultat de ce prétraitement comme valeur du paramètre layout. Ici, le circular layout:
Il existe une multitude de layouts. Je peux tous les afficher d’un coup, pour jeter un coup d’œil à la forme qu’ils prennent, et choisir celui qui m’intéresse le plus
layouts <- grep("^layout_", ls("package:igraph"), value=TRUE)[-1]
# J'en retire certains si je veux
layouts <- layouts[!grepl("bipartite|merge|norm|sugiyama|tree", layouts)]
#je prépare la mise en page du résultat
par(mfrow=c(3,3), mar=c(1,1,1,1))
#Je fais un boucle: un graph par itération
for (layout in layouts) {
print(layout)
l <- do.call(layout, list(data))
plot(data_simplified, edge.arrow.mode=0, layout=l, main=layout) }S’il y en a un qui m’intéresse, je peux l’appliquer de la même manière que pour le cercle.
Evidemment, je ne dois choisir un graphe adapté…
Il semble que la forme en étoile soit bien adaptée, étant donné la centralité de Molière:
Les tracés les plus importants sont les forced base, qui nécessitent des algorithmes particuliers. Regrdons-les en détail.
Fruchterman, Thomas M. J.; Reingold, Edward M. (1991), “Graph Drawing by Force-Directed Placement”, Software – Practice & Experience, Wiley, 21 (11): 1129–1164, doi:10.1002/spe.4380211102.
Plus d’informations ici
Le algorithme est assez comppliqué, et le temprs de calcul conséquent. On l’utilise peu avec des grandes bases de données (plus de 10 000 nœuds).
layout_fr<-layout_with_fr(data_simplified)
E(data_simplified)$width <-E(data_simplified)$weight
plot(data_simplified, layout=layout_fr,
#J'ajoute les poids
weight=TRUE,
#pas de courbure de l'arête
edge.curved=0)On peut jouer sur les paramètres et augmenter le nombre d’itération
#Je passe sur 2 colonnes, 2 rangs
par(mfrow=c(2, 2))
#J'ajuste la marge pour le titre
par(oma=c(1,1,1,1))
## layout_with_fr
plot.igraph(data_simplified, layout = layout_with_fr(data_simplified, niter = 1), main = 1)
plot.igraph(data_simplified, layout = layout_with_fr(data_simplified, niter = 5), main = 5)
plot.igraph(data_simplified, layout = layout_with_fr(data_simplified, niter = 10), main = 10)
plot.igraph(data_simplified, layout = layout_with_fr(data_simplified, niter = 20), main = 20)
plot.igraph(data_simplified, layout = layout_with_fr(data_simplified, niter = 50), main = 50)
plot.igraph(data_simplified, layout = layout_with_fr(data_simplified, niter = 75), main = 75)
plot.igraph(data_simplified, layout = layout_with_fr(data_simplified, niter = 100), main = 100)
plot.igraph(data_simplified, layout = layout_with_fr(data_simplified, niter = 150), main = 150)
plot.igraph(data_simplified, layout = layout_with_fr(data_simplified, niter = 200), main = 200)
plot.igraph(data_simplified, layout = layout_with_fr(data_simplified, niter = 300), main = 300)
plot.igraph(data_simplified, layout = layout_with_fr(data_simplified, niter = 500), main = 500)
plot.igraph(data_simplified, layout = layout_with_fr(data_simplified, niter = 700), main = 700)
title("No. of Iterations (layout_with_fr)", outer = TRUE)
par(mfrow=c(1, 1))
par(oma=c(0,0,0,0))Voyons le résultat apèrs 700 itérations:
## J'épaissis l'arête en fonction du poids
E(data_simplified)$width <-E(data_simplified)$weight
plot.igraph(data_simplified,
layout = layout_with_fr(data_simplified, niter = 700),
main = 700,
#pas de courbure de l'arête
edge.curved=0,
#taille de la police
vertex.label.cex=0.6,
# Taile du nœud
vertex.size = 8)
title("700 itérations", outer = TRUE)Le nom a changé plusieurs fois: d’abord rebaptisé vxOrd, on parle d’OpenOrd.
Plus d’informations ici
Il va tenter de faire ressortir au maximum des grands clusters très nets en coupant les liens les plus longs. Evidemment cet algorithme nécessite des graphes de grande taille, nous chargeons donc un gros jeu de données tiré du package igraphdata.
data("USairports")
#On trace le graphe
layout_drl <- layout.drl(USairports)
plot(USairports, layout=layout_drl, main="DrL")Nous pouvons comparer l’effet de ce découpage avec celui effectué par l’algorithme précédent, Fruchterman Reingold
par(mfrow=c(1, 2))
par(oma=c(0,0,2,0))
plot(USairports, layout=layout_with_fr(USairports), weight=T, main="FR")
plot(USairports, layout=layout_drl, main="DrL")GeolayoutJ’ai préparé un tout petit jeu de données avec des coordonnées géographiques
nodes_geo <- as.data.frame(read.csv(file="data/geo/nodes.csv", sep = "\t", header = FALSE))
edges_geo <- as.data.frame(read.csv(file="data/geo/edges.csv", sep = "\t", header = FALSE))
#Je donne un nom aux colonnes de chaque data.frame
colnames(nodes_geo) <- c("id", "label","lat","long")
colnames(edges_geo) <- c("from", "to")
nodes_geo
edges_geo## id label lat long
## 1 1 Paris 48.86472 2.349014
## 2 2 Bruxelles 50.85045 4.348780
## 3 3 Geneve 46.20439 6.143158
## 4 4 Londres 51.50853 -0.125740
## from to
## 1 1 2
## 2 1 3
## 3 1 4
Je transforme ces deux objets en données igraph, qui vont me permettre de faire mes analyses de réseau par la suite.
data_geo <- graph_from_data_frame(d=edges_geo, vertices=nodes_geo, directed=F)
class(data_geo)
plot(data_geo)Je projette ce réseau sur une carte, en plaçant les nœuds en fonction de leurs coordonnées géographiques
#Je définis les lat et long de mon cadre
western_europe<-c(left = -12, bottom = 40, right = 20, top = 55)
#Je récupère mon fond de carte selon les dimensions prévues supra
map <- get_stamenmap(western_europe, zoom=6, source="stamen", maptype="toner-lite", filetype="png")
#Je crée une carte à partir de mon fond de carte
p<-ggmap(map)
#J'ajoute les arêtes
p = p + geom_edgeset(aes(x=long, y=lat), data_geo, colour=gray(0.1, 0.3), size=1)
#J'ajoute les nœuds
p = p + geom_nodeset(aes(x=long, y=lat), data_geo, size=3, colour="red")
#J'affiche le tout
pDensité (density): la proportion de liens dans un réseau relativement au total des liens possibles.
## [1] 0.6894587
Centralité de proximité: Distance moyenne du nœud à tous les autres nœuds (Closeness)
## 1 2 3 4 5 6
## 0.03846154 0.02439024 0.02500000 0.02439024 0.02439024 0.02173913
## 7 8 9 10 12 13
## 0.02564103 0.02040816 0.02380952 0.02380952 0.02439024 0.02040816
## 14 15 16 17 18 19
## 0.02380952 0.02380952 0.02380952 0.02173913 0.02083333 0.02083333
## 20 21 22 23 24 25
## 0.02083333 0.02083333 0.02000000 0.02000000 0.02127660 0.02127660
## 26 27 28
## 0.02173913 0.02040816 0.02000000
Pour rappel, les noms attachés sont accessibles ainsi:
## closeness.cent
## 1 "Molière" "0.0384615384615385"
## 2 "Guillaume de Luyne" "0.024390243902439"
## 3 "Claude Barbin" "0.025"
## 4 "Charles de Sercy" "0.024390243902439"
## 5 "Jean Hénault" "0.024390243902439"
## 6 "François Noël" "0.0217391304347826"
## 7 "Christophe Journel" "0.0256410256410256"
## 8 "Sieur de Neuf-Villenaine" "0.0204081632653061"
## 9 "Jean Ribou" "0.0238095238095238"
## 10 "Jean Guignard" "0.0238095238095238"
## 12 "Gabriel Quinet" "0.024390243902439"
## 13 "François II Noël" "0.0204081632653061"
## 14 "Thomas Jolly" "0.0238095238095238"
## 15 "Louis Billaine" "0.0238095238095238"
## 16 "Estienne Loyson" "0.0238095238095238"
## 17 "Claude Blageart" "0.0217391304347826"
## 18 "Pierre Trabouillet" "0.0208333333333333"
## 19 "Nicolas Le Gras" "0.0208333333333333"
## 20 "Théodore Girard" "0.0208333333333333"
## 21 "Etienne Maucroy" "0.0208333333333333"
## 22 "Claude II Calleville" "0.02"
## 23 "Claude Audinet" "0.02"
## 24 "Pierre Le Monnier" "0.0212765957446809"
## 25 "Pierre Corneille" "0.0212765957446809"
## 26 "Philippe Quinault" "0.0217391304347826"
## 27 "Pierre Promé" "0.0204081632653061"
## 28 "François Muguet" "0.02"
Centralité d’intermédiarité: Nombre de fois que le nœud se trouve sur le plus court chemin entre deux autres nœuds (Betweenness)
## 1 2 3 4 5 6
## 222.8397763 0.9600000 4.3209524 0.9600000 0.3900000 0.0000000
## 7 8 9 10 12 13
## 5.0683883 0.0000000 10.2680258 0.0000000 2.3714286 0.0000000
## 14 15 16 17 18 19
## 0.0000000 0.0000000 0.0000000 0.9166667 0.0000000 0.0000000
## 20 21 22 23 24 25
## 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000
## 26 27 28
## 0.9047619 0.0000000 0.0000000
Centralité de vecteurs propres: Score d’autorité attribué à un nœud en fonction du score de ses voisins. (Eigenvector).
## 1 2 3 4 5 6
## 1.00000000 0.56536647 0.65991521 0.56536647 0.23172674 0.10190675
## 7 8 9 10 12 13
## 0.55278661 0.06001095 0.55255801 0.48574803 0.58647420 0.06403130
## 14 15 16 17 18 19
## 0.27379413 0.27379413 0.27379413 0.49263907 0.03116947 0.03116947
## 20 21 22 23 24 25
## 0.03116947 0.03116947 0.04425426 0.04425426 0.17947299 0.06611127
## 26 27 28
## 0.09469017 0.05829650 0.03120315
Centralité de degré: Nombre de connexions du nœud (Degree)
## 1 2 3 4 5 6 7 8 9 10 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
## 82 36 42 36 15 6 33 3 33 30 36 3 18 18 18 27 4 4 4 4 2 2 11 5 7
## 27 28
## 3 2
On peut réutiliser ces données pour la visualisation, en ajustant la taille des nœuds à la centralité de degré
On peut ajuster cette taille avec d’autres mesures de centralité, comme la centralité de vecteur
V(data_simplified)$size <- (closeness.eig$vector*30)
plot(data_simplified, layout=layout_fr, main="FR")Tentons une approche plus pratique avec un réseau célèbre: celui de la Florence de la Renaissance (disponible dans le package netrankr).
data("florentine_m")
#Une famille n'est pas reliée aux autres: la famille Pucci
degree(florentine_m)==0
#On la retire pour simplifier la visualisation
florence <- delete_vertices(florentine_m,which(degree(florentine_m)==0))## Acciaiuol Albizzi Barbadori Bischeri Castellan Ginori Guadagni
## FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## Lambertes Medici Pazzi Peruzzi Pucci Ridolfi Salviati
## FALSE FALSE FALSE FALSE TRUE FALSE FALSE
## Strozzi Tornabuon
## FALSE FALSE
J’obtiens un joli graphe:
plot.igraph(florence, layout = layout_with_fr(florence, niter = 500),
main = "Florence au XVème s.")Je peux proportionner la taille des nœuds en fonction de la fortune de chaque famille:
plot(florence,
layout = layout_with_fr(florence, niter = 500),
vertex.label.cex=V(florence)$wealth*0.012,
vertex.size=V(florence)$wealth*0.2)Mais est-ce que la richesse fait tout? Probablement pas… tentons d’évaluer la centralité des différentes familles
#Je fais un data-frame à partir de différents calculs de centralité
cent.data_frame <- data.frame(
degree = degree(florence),
betweenness = betweenness(florence),
closeness = closeness(florence),
eigenvector = eigen_centrality(florence)$vector,
subgraph = subgraph_centrality(florence))
#Je peux accéder au résultat sous la forme de tableau qui résume toutes les données
View(cent.data_frame)
# Je donne le nom de la famille la plus centrale pour chaque mesure
V(florence)$name[apply(cent.data_frame,2,which.max)]## [1] "Medici" "Medici" "Medici" "Medici" "Medici"
Il est possible de proposer une foule de visualisation. Par exemple, il est possible de remplacer les labels par la distance qui sépare un nœud d’un autre – ici, Thomas Jolly.
dist.thoJo <- distances(data, v=V(data)[label=="Thomas Jolly"], to=V(data), weights=NA)
# Set colors to plot the distances:
green.dark <- colorRampPalette(c("darkgreen", "lightgreen"))
col <- green.dark(max(dist.thoJo)+1)
col <- col[dist.thoJo+1]
plot(data, vertex.color=col, vertex.label=dist.thoJo)On peut mettre en valeur le chemin le plus court entre deux poins
mon_chemin <- shortest_paths(data,
from = V(data)[label=="Thomas Jolly"],
to = V(data)[label=="Pierre Corneille"],
#je colorie le nœud et l'arête
output = "both")
# On génère une couleur pour les arêtes en fonction du chemin
couleur_arc <- rep("gray80", ecount(data))
couleur_arc[unlist(mon_chemin$epath)] <- "orange"
"Couleur des arcs"
couleur_arc #cf. 128 et 219
# On génère une largeur pour l'arête en fonction du chemin
largeur_arc <- rep(2, ecount(data))
largeur_arc[unlist(mon_chemin$epath)] <- 6
"Largeur des arcs"
largeur_arc #cf. 128 et 219
# Generate node color variable to plot the path:
coleur_noeud <- rep("gray40", vcount(data))
coleur_noeud[unlist(mon_chemin$vpath)] <- "gold"
"Les nœuds"
coleur_noeud #cf. 1 et 13
plot(data, vertex.color=coleur_noeud, edge.color=couleur_arc,
edge.width=largeur_arc, edge.arrow.mode=0)On peut aussi regrouper en cluster les données, que l’on représente en dendogramme, comme pour la stylométrie
Je projette ensuite ma classification sur mon graph
On peut l’afficher en 3d. Pour cela j’utilise le paramètre dim=3 pour mon layout.
Je peux faire une sauvegarde, notamment en HTML pour l’ouvrir dans le navigateur
dirfolder=getwd()
#open3d plutôt que rgl.open() pour une sauvegarde
open3d()
rglplot(data_simplified, layout=coords)
#Je prépare l'angle
rgl.viewpoint(theta=0, phi=0)
#Sauvegarder un screenshot (en png)
rgl.snapshot(paste(dirfolder,"monGRaph3d.png",sep=""), fmt="png", top=TRUE)
#Sauvegarde en html
rglfolder=writeWebGL(dir = paste(dirfolder,"first_net3d",sep=""), width=900)
#J'ouvre le résultat dans le navigateur
browseURL(rglfolder)Je peux produire une visualisation interactive directement dans R. Je prépare les données
# je convertis mon igraphe en une liste composée de deux data.frames (nodes et edges)
data_3d_vis <- toVisNetworkData(data)
# Pour le menu déroulant (cf infra)
names <- sort(data_3d_vis$nodes$label)Et je lance une visualisation en 3D
visNetwork(nodes = data_3d_vis$nodes,
edges = data_3d_vis$edges,
main = "Mon graphe interactif",
submain = "Alogirhtme de Fruchterman–Reingold",
footer = "Wow") %>%
#Je trace le graphe
visIgraphLayout(layout = "layout_with_fr",
smooth = FALSE,
#J'ajoute de la dynamique (cf. _infra_)
physics = TRUE
)Je rajoute des options de visualisation, comme une modification des nœuds s’ils sont sélectionnés, ou un selecteur sous la forme de liste déroulante
visNetwork(nodes = data_3d_vis$nodes,
edges = data_3d_vis$edges,
main = "Mon graphe interactif",
submain = "Alogirhtme de Fruchterman–Reingold",
footer = "Wow") %>%
#Je trace le graphe
visIgraphLayout(layout = "layout_with_fr",
smooth = FALSE,
#J'ajoute de la dynamique (cf. _infra_)
physics = TRUE
) %>%
#Je mets en valeur les nœuds liés
visOptions(highlightNearest = list(enabled = TRUE,
#séparés de 1 degré
degree = 1,
#il s'illuminent quand la souris passe sur le nœud
hover = TRUE),
#Je crée un sélecteur
nodesIdSelection = list(enabled = TRUE,
values = names))Je vais avoir besoin “d’écarter” mon graphe, en ajoutant de la répulsion entre les nœuds (ce qui n’est pas tâche facile…)
data_3d_vis_plot <- visNetwork(nodes = data_3d_vis$nodes,
edges = data_3d_vis$edges,
main = "Mon graphe interactif",
submain = "Alogirhtme de Fruchterman–Reingold",
footer = "Wow") %>%
#Je trace le graphe
visIgraphLayout(layout = "layout_with_fr",
smooth = FALSE,
#J'ajoute de la dynamique (cf. _infra_)
physics = TRUE
) %>%
#Je mets en valeur les nœuds liés
visOptions(highlightNearest = list(enabled = TRUE,
#séparés de 1 degré
degree = 1,
#passage souris
hover = TRUE),
#Je crée un sélecteur
nodesIdSelection = list(enabled = TRUE,
values = names)
) %>%
#taille des nœuds
visNodes(size = 50) %>%
#couleur des arêtes
visEdges(color = list(highlight = "lightgray")) %>%
#Je paramètre la répulsion
visPhysics(#Vélocité des nœuds
maxVelocity = 1,
#type de répulsion hiérarchique
solver = "forceAtlas2Based",
#paramètres du forceAtlas2Based
#la `gravitationalConstant` décrit la répulsion (l'écartement entre les nœuds), le chiffre est donc négatif, sinon oncrée de l'attraction
forceAtlas2Based = list(gravitationalConstant = -1000)
)
data_3d_vis_plotOn sauvegarde le résultat
write_graph(data, "edgelist.txt", format="edgelist")
svg(file="monGraph.svg")
plot(data)
dev.off()
png(file="monGraph.png")
plot(data)
dev.off()100% center
100% center